home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / opbonus.arc / FBROWSE.ARC / FBDMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-20  |  55KB  |  1,888 lines
  1. {$I-,V-,S-,R-,F-,B-}
  2.  
  3. {*********************************************************}
  4. {*                   FBDMAIN.PAS 5.06                    *}
  5. {*     Copyright (c) Enz EDV Beratung GmbH 1986-89.      *}
  6. {*                 All rights reserved.                  *}
  7. {*          Modified and used under license by           *}
  8. {*                 TurboPower Software.                  *}
  9. {*********************************************************}
  10.  
  11. {$I BTDEFINE.INC}
  12. {$I OPDEFINE.INC}
  13.  
  14. {$IFDEF DynamicNet}
  15.  {$DEFINE Novell}
  16. {$ENDIF}
  17.  
  18. {.$DEFINE TestStream}  {enable this define to test streams support}
  19.  
  20. unit FbdMain;
  21.   {-Main program block}
  22.  
  23. {The following IFNDEF statements ensure BTDEFINE.INC is properly setup to
  24.  compiler this program}
  25.  
  26. {$IFNDEF UseOPCRT}
  27.   *ERROR* This program requires UseOPCRT to be defined in BTDEFINE.INC.
  28. {$ENDIF}
  29.  
  30. interface
  31.  
  32. uses
  33.   {.......................... Turbo Pascal units}
  34.   Dos,                       {standard DOS unit}
  35.   {.......................... Object Professional units}
  36.   OpRoot,                    {low-level objects, error codes, etc.}
  37.   OpInline,                  {useful inline macros}
  38.   OpString,                  {string handling}
  39.   OpCrt,                     {basic screen handling}
  40.   {$IFDEF UseMouse}
  41.   OpMouse,
  42.   {$ENDIF}
  43.   OpCmd,                     {command processing}
  44.   OpFrame,                   {window frames}
  45.   OpWindow,                  {windows}
  46.   OpField,                   {data entry fields}
  47.   OpSelect,                  {abstract selector}
  48.   OpEntry,                   {data entry screens}
  49.   OpMemo,                    {memo editor}
  50.   {.......................... Optional NetWare support}
  51.   {$IFDEF Novell}
  52.   NetSema,                   {BONUS NetWare Semaphore unit}
  53.   OopSema,                   {OOP Semaphore unit}
  54.   {$ENDIF}
  55.   {.......................... B-Tree Filer units}
  56.   Filer,                     {database management}
  57.   VRec,                      {variable length records}
  58.   VRebuild,                  {database repair--variable length records}
  59.   FBrowse;                   {object-oriented database browser}
  60.  
  61. procedure FBDemoMain;
  62.   {-Main body of FBDEMO}
  63.  
  64.   {=======================================================================}
  65.  
  66. implementation
  67.  
  68. const
  69.   {increase this to see an example of what multi-line items look like}
  70.   RowsPerItem    = 1;        {number of rows per browser item}
  71.  
  72.   Key1Len        = 30;       {Uppercase last name+first name}
  73.   Key2Len        = 5;        {First five digits of zip}
  74.   MaxCols        = 101;      {length of one row}
  75.  
  76.   FName          = 'ADDRESS'; {Root name for database}
  77.   LstDevice      = 'PRN';    {Where printed output goes}
  78.  
  79.   Header         : String[80] = {Basic string used to build display header}
  80.   ' B-Tree Filer Demo Program                                                      ';
  81.  
  82.   F1             = $3B00;    {Keycodes for function keys}
  83.   F2             = $3C00;
  84.   F3             = $3D00;
  85.   F4             = $3E00;
  86.   F5             = $3F00;
  87.   F6             = $4000;
  88.   F7             = $4100;
  89.   F8             = $4200;
  90.   F9             = $4300;
  91.   F10            = $4400;
  92.   AltR           = $1300;
  93.   AltM           = $3200;
  94.   AltZ           = $2C00;
  95.  
  96.   SectionLength  = 140;      {each record will use from 1 to 8 sections}
  97.   MaxMemoSize    = 932;      {140*8 = 1120, (7*(140-7))+1 = 932}
  98. type
  99.   CharSet        = set of Char;
  100.   OpenMode       = (NormalMode, SaveMode);
  101.   MemoField      = array[1..MaxMemoSize] of Char;
  102.  
  103.   PersonDef =                        {Definition of the database record}
  104.     record
  105.       Dele           : LongInt;
  106.       FirstName      : String[15];
  107.       Name           : String[15];
  108.       Company        : String[25];
  109.       Address        : String[25];
  110.       City           : String[15];
  111.       State          : String[2];
  112.       Zip            : String[10];
  113.       Telephone      : String[12];
  114.       NotesLen       : Word;         {<-- 133 bytes to here}
  115.       Notes          : MemoField;    {memo field: 1..MaxMemoSize bytes}
  116.     end;                             {1065 bytes maximum, 134 minimum}
  117.  
  118. var
  119.   PS             : LongInt;          {Pages in page stack}
  120.   Pf             : IsamFileBlockPtr; {Isam management variable}
  121.  
  122.   Person         : PersonDef;        {Currently selected record}
  123.   PersonFilter   : PersonDef;        {used for filtering}
  124.   ActRec         : LongInt;          {Record number currently selected}
  125.   ActKeyNr       : Integer;          {Active key number, 1 or 2}
  126.   ActKey         : IsamKeyStr;       {Active key string}
  127.  
  128.   DatLen         : Word;
  129.   BrowExit       : Word;
  130.   AC             : Char;
  131.   Mode           : OpenMode;
  132.   Locked         : Boolean;
  133.  
  134.   {colors}
  135.   HeadFootAttr   : Byte;
  136.   SaveAttr       : Byte;
  137. const
  138.   FbColors : ColorSet = (
  139.     TextColor       : $1E; TextMono       : $07;
  140.     CtrlColor       : $3E; CtrlMono       : $70;
  141.     FrameColor      : $1F; FrameMono      : $0F;
  142.     HeaderColor     : $3E; HeaderMono     : $70;
  143.     ShadowColor     : $08; ShadowMono     : $70;
  144.     HighlightColor  : $4E; HighlightMono  : $0F;
  145.     PromptColor     : $1B; PromptMono     : $07;
  146.     SelPromptColor  : $1B; SelPromptMono  : $07;
  147.     ProPromptColor  : $1B; ProPromptMono  : $07;
  148.     FieldColor      : $1E; FieldMono      : $07;
  149.     SelFieldColor   : $3E; SelFieldMono   : $70;
  150.     ProFieldColor   : $1E; ProFieldMono   : $07;
  151.     ScrollBarColor  : $17; ScrollBarMono  : $07;
  152.     SliderColor     : $17; SliderMono     : $07;
  153.     HotSpotColor    : $71; HotSpotMono    : $07;
  154.     BlockColor      : $0F; BlockMono      : $0F;
  155.     MarkerColor     : $0F; MarkerMono     : $70;
  156.     DelimColor      : $1B; DelimMono      : $07;
  157.     SelDelimColor   : $1B; SelDelimMono   : $07;
  158.     ProDelimColor   : $1B; ProDelimMono   : $07;
  159.     SelItemColor    : $3E; SelItemMono    : $70;
  160.     ProItemColor    : $1E; ProItemMono    : $07;
  161.     HighItemColor   : $1F; HighItemMono   : $0F;
  162.     AltItemColor    : $1F; AltItemMono    : $0F;
  163.     AltSelItemColor : $3E; AltSelItemMono : $70;
  164.     FlexAHelpColor  : $1F; FlexAHelpMono  : $0F;
  165.     FlexBHelpColor  : $1F; FlexBHelpMono  : $0F;
  166.     FlexCHelpColor  : $1B; FlexCHelpMono  : $70;
  167.     UnselXrefColor  : $1E; UnselXrefMono  : $09;
  168.     SelXrefColor    : $5F; SelXrefMono    : $70;
  169.     MouseColor      : $4A; MouseMono      : $70
  170.   );
  171.  
  172.   {data entry stuff}
  173. const
  174.   PhoneMask      : String[12] = '999-999-9999';
  175.   ValidPhone     : String[12] = 'ppp-uuu-uuuu';
  176.   ZipMask        : String[10] = '99999-9999';
  177.   ValidZip       : String[10] = 'uuuuu-pppp';
  178.   ValidationOff  : Boolean = False;
  179.  
  180.   {field IDs}
  181.   idFirstName    = 0;
  182.   idLastName     = 1;
  183.   idCompany      = 2;
  184.   idAddress      = 3;
  185.   idCity         = 4;
  186.   idState        = 5;
  187.   idZipCode      = 6;
  188.   idPhone        = 7;
  189.   idNotes        = 8;
  190.  
  191.   {coordinates for entry screen and memo field windows}
  192.   EntryXL        = 29;
  193.   EntryYL        = 04;
  194.   EntryXH        = 78;
  195.   EntryYH        = 12;
  196.   MemoXL         = 29;
  197.   MemoYL         = 15;
  198.   MemoXH         = 78;
  199.   MemoYH         = 22;
  200. var
  201.   VB             : VBrowser;    {variable-length record data file browser}
  202.   ES             : EntryScreen; {for entry screens}
  203.   M              : Memo;        {for memo fields}
  204.   ScrapPerson    : PersonDef;   {used for editing}
  205.   VRecLen        : Word;
  206.   {$IFDEF Novell}
  207.   Sync           : FilerSemaphore;
  208.   {$ENDIF}
  209.  
  210. {$I FBDMAIN.IN1} {misc. screen stuff, semaphores, move/zoom/resize,
  211.                   validation/conversion routines}
  212.  
  213.   procedure ClearPerson(var Person : PersonDef);
  214.     {-Set up for a new person record}
  215.   begin
  216.     FillChar(Person, SizeOf(PersonDef), 0);
  217.     Person.NotesLen := 1;
  218.     Person.Notes[1] := ^Z;
  219.   end;
  220.  
  221.   function CompPerson(var P1, P2 : PersonDef) : Boolean;
  222.     {-Compare two person records}
  223.   begin
  224.     CompPerson := False;
  225.     if P1.Dele <> P2.Dele then
  226.       Exit;
  227.     if P1.FirstName <> P2.FirstName then
  228.       Exit;
  229.     if P1.Name <> P2.Name then
  230.       Exit;
  231.     if P1.Company <> P2.Company then
  232.       Exit;
  233.     if P1.Address <> P2.Address then
  234.       Exit;
  235.     if P1.City <> P2.City then
  236.       Exit;
  237.     if P1.State <> P2.State then
  238.       Exit;
  239.     if P1.Zip <> P2.Zip then
  240.       Exit;
  241.     if P1.Telephone <> P2.Telephone then
  242.       Exit;
  243.     if P1.NotesLen <> P2.NotesLen then
  244.       Exit;
  245.  
  246.     {compare memo fields quickly using routine in OPSTRING}
  247.     if CompStruct(P1.Notes, P2.Notes, P1.NotesLen) <> Equal then
  248.       Exit;
  249.  
  250.     CompPerson := True;
  251.   end;
  252.  
  253.   procedure FixHeader(Header : String; RecNum : LongInt);
  254.     {-Fix the entry screen's header}
  255.   var
  256.     Redraw : Boolean;
  257.   begin
  258.     {fix the header}
  259.     if RecNum <> 0 then
  260.       Header := Header+' Record # '+Long2Str(RecNum);
  261.     with ES, wFrame do
  262.       ChangeHeaderString(0, ' '+Header+' ', Redraw);
  263.   end;
  264.  
  265.   procedure DisplayMemoField;
  266.     {-Display the memo field}
  267.   begin
  268.     {reinitialize}
  269.     M.ReinitBuffer;
  270.     ScrapPerson.NotesLen := M.meTotalBytes;
  271.  
  272.     {display the contents of the memo}
  273.     M.Draw;
  274.   end;
  275.  
  276.   procedure EraseWindows;
  277.     {-Erase the two windows}
  278.   begin
  279.     if ES.IsCurrent then
  280.       ES.Erase;
  281.     if M.IsCurrent then
  282.       M.Erase;
  283.     if ES.IsCurrent then
  284.       ES.Erase;
  285.   end;
  286.  
  287.   procedure DisplayMemoPrompt;
  288.     {-Display prompt at bottom of screen while editing}
  289.   begin
  290.     WriteFooter(
  291.       Center('Press <^Enter> when done editing notes to return to entry screen',
  292.              ScreenWidth));
  293.   end;
  294.  
  295.   procedure DisplayPerson(var Person : PersonDef; Header : String;
  296.                           RecNum : LongInt);
  297.     {-Show data about person}
  298.   begin
  299.     {copy into our scrap record}
  300.     ScrapPerson := Person;
  301.  
  302.     {change the entry screen's header}
  303.     FixHeader(Header, RecNum);
  304.  
  305.     {display entry screen}
  306.     ES.Draw;
  307.  
  308.     {display memo field if appropriate}
  309.     if RecNum <> 0 then
  310.       DisplayMemoField;
  311.   end;
  312.  
  313.   procedure EditMemoField;
  314.     {-Edit the memo field}
  315.   begin
  316.     {display prompt}
  317.     DisplayMemoPrompt;
  318.  
  319.     {do the editing}
  320.     M.Select;
  321.     M.Process;
  322.  
  323.     {save the number of bytes in the buffer}
  324.     ScrapPerson.NotesLen := M.meTotalBytes;
  325.   end;
  326.  
  327.   function GetPerson(var Person : PersonDef; NameRequired : Boolean;
  328.                      Header : String; RecNum : LongInt) : Boolean;
  329.     {-Edit a person record}
  330.   var
  331.     Done : Boolean;
  332.   begin
  333.     {copy into our scrap record}
  334.     ScrapPerson := Person;
  335.  
  336.     {need special validation?}
  337.     ValidationOff := not NameRequired;
  338.  
  339.     {set required status for last name}
  340.     ES.ChangeRequired(idLastName, NameRequired);
  341.  
  342.     {hide Notes field if searching}
  343.     ES.ChangeHidden(idNotes, not NameRequired);
  344.  
  345.     {change the entry screen's header}
  346.     FixHeader(Header, RecNum);
  347.  
  348.     {draw the memo window if not searching}
  349.     if NameRequired then
  350.       DisplayMemoField;
  351.  
  352.     {start editing on first field}
  353.     ES.SetNextField(idFirstName);
  354.  
  355.     Done := False;
  356.     repeat
  357.       {start editing}
  358.       ES.Process;
  359.  
  360.       {see if we need to edit another record}
  361.       case ES.GetLastCommand of
  362.         ccDone :             {^Enter, ^KD, or ^KQ}
  363.           begin
  364.             Done := True;
  365.             GetPerson := True;
  366.           end;
  367.         ccError,             {fatal error}
  368.         ccQuit :             {Esc}
  369.           begin
  370.             Done := True;
  371.             GetPerson := False;
  372.           end;
  373.         ccNested :
  374.           {edit the notes field}
  375.           if NameRequired then begin
  376.             EditMemoField;
  377.             ES.Select;
  378.           end;
  379.       end;
  380.     until Done;
  381.  
  382.     {erase the two windows}
  383.     EraseWindows;
  384.  
  385.     {return modified record, even if <Esc> was pressed--caller will ignore
  386.      changes if appropriate}
  387.     Person := ScrapPerson;
  388.  
  389.     {clear the prompt line}
  390.     WriteFooter('');
  391.   end;
  392.  
  393.   function CreateFile : Boolean;
  394.     {-Create the database fileblock}
  395.   var
  396.     IID : IsamIndDescr;
  397.   begin
  398.     IID[1].KeyL := Key1Len;
  399.     IID[1].AllowDupK := False;
  400.     IID[2].KeyL := Key2Len;
  401.     IID[2].AllowDupK := True;
  402.     MakeNetFileBlock(Pf, FName, SectionLength, 2, IID);
  403.     CreateFile := IsamOK;
  404.   end;
  405.  
  406.   function PersonLine(var Person : PersonDef) : String;
  407.     {-Return a string representing Person}
  408.   const
  409.     HaveNotes : array[Boolean] of Char = (' ', #251);
  410.   begin
  411.     with Person do
  412.       PersonLine :=
  413.         Extend(Zip, 5)+' '+
  414.         Extend(Trim(Name)+', '+Trim(FirstName), 19)+' '+
  415.         Extend(Company, 19)+' '+
  416.         Extend(Address, 19)+' '+
  417.         Extend(City, 13)+' '+
  418.         Extend(State, 2)+' '+
  419.         Extend(Telephone, 12)+' '+
  420.         HaveNotes[NotesLen > 1];
  421.   end;
  422.  
  423.   {$F+} {the next three routines are called indirectly}
  424.  
  425.   function BuildKey(var P; KeyNr : Integer) : IsamKeyStr;
  426.     {-Return the key string for either of the two indexes}
  427.   begin
  428.     with PersonDef(P) do
  429.       case KeyNr of
  430.         1 : BuildKey := Extend(StUpCase(Trim(Name)),20)+
  431.                         Extend(StUpCase(Trim(FirstName)),10);
  432.         2 : BuildKey := Copy(Zip, 1, 5);
  433.       end;
  434.   end;
  435.  
  436.   procedure BuildRow(Row : Byte; var DatS; DatLen : Word; Ref : LongInt;
  437.                      Key : IsamKeyStr; var S : string; FBP : FBrowserPtr);
  438.     {-Return one row of an item to the browser}
  439.   var
  440.     P : PersonDef absolute DatS;
  441.     SLen : Byte absolute S;
  442.   begin
  443.     if Row > 1 then
  444.       S := '----- row '+Long2Str(row)+' of record '+Long2Str(Ref)
  445.     else if Ref <> -1 then
  446.       S := PersonLine(P)
  447.     else begin
  448.       {Record is locked, indicate it on screen}
  449.       S := '';
  450.       while SLen < MaxCols do
  451.         S := S+'**   ';
  452.       SLen := MaxCols;
  453.     end;
  454.   end;
  455.  
  456.   procedure UpdateScreen(FBP : FBrowserPtr);
  457.     {-Called by FBROWSE on each screen update}
  458.   {
  459.            1         2         3         4         5         6         7         8         9         1
  460.   1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
  461.    Zip   Name                Company             Address             City         St  Phone       Notes
  462.   zzzzz nnnnnnnnnnnnnnnnnnn ccccccccccccccccccc aaaaaaaaaaaaaaaaaaa ccccccccccccc ss ppp-ppp-pppp n
  463.   }
  464.   const
  465.     Header =
  466.     ' Zip   Name                Company             Address             City         St  Phone       Notes';
  467.   begin
  468.     with fbColors, FBP^ do
  469.       {Write the header line now}
  470.       fFastWrite(
  471.         Extend(Copy(Header, GetCurrentCol, Width), Width), 1, 1,
  472.         ColorMono(HighlightColor, HighlightMono));
  473.   end;
  474.  
  475.   {$F-}
  476.  
  477.   function AddStructure(var P : PersonDef; var Rec : LongInt) : Boolean;
  478.     {-Add a new record}
  479.   begin
  480.     AddStructure := False;
  481.     repeat
  482.       AddVariableRec(Pf, Rec, P, P.NotesLen+SizeOf(PersonDef)-SizeOf(MemoField));
  483.       if LockAbort then
  484.         Exit;
  485.     until not Locked;
  486.     if not IsamOK then
  487.       IsamErrorNum(IsamError)
  488.     else begin
  489.       VB.fbOptionsOn(fbForceUpdate);
  490.       AddStructure := True;
  491.     end;
  492.   end;
  493.  
  494.   function ModStructure(var P : PersonDef; Rec : LongInt) : Boolean;
  495.     {-Write record over previous version}
  496.   begin
  497.     ModStructure := False;
  498.     repeat
  499.       PutVariableRec(
  500.         Pf, Rec, P, P.NotesLen+SizeOf(PersonDef)-SizeOf(MemoField), Normal);
  501.       if LockAbort then
  502.         Exit;
  503.     until not Locked;
  504.     if not IsamOK then
  505.       IsamErrorNum(IsamError)
  506.     else begin
  507.       VB.fbOptionsOn(fbForceUpdate);
  508.       ModStructure := True;
  509.     end;
  510.   end;
  511.  
  512.   function DelStructure(var Rec : LongInt) : Boolean;
  513.     {-Delete record}
  514.   begin
  515.     DelStructure := False;
  516.     repeat
  517.       DeleteVariableRec(Pf, Rec);
  518.       if LockAbort then
  519.         Exit;
  520.     until not Locked;
  521.     if not IsamOK then
  522.       IsamErrorNum(IsamError)
  523.     else begin
  524.       VB.fbOptionsOn(fbForceUpdate);
  525.       DelStructure := True;
  526.     end;
  527.   end;
  528.  
  529.   function AddKey(K : IsamKeyStr; Rec : LongInt; KeyNr : Integer) : Boolean;
  530.     {-Add new key}
  531.   begin
  532.     AddKey := False;
  533.     repeat
  534.       AddNetKey(Pf, KeyNr, Rec, K);
  535.       if LockAbort then
  536.         Exit;
  537.     until not Locked;
  538.     if not IsamOK then
  539.       IsamErrorNum(IsamError)
  540.     else
  541.       AddKey := True;
  542.   end;
  543.  
  544.   function EraseKey(K : IsamKeyStr; Rec : LongInt; KeyNr : Integer) : Boolean;
  545.     {-Remove a key}
  546.   begin
  547.     EraseKey := False;
  548.     repeat
  549.       DeleteNetKey(Pf, KeyNr, Rec, K);
  550.       if LockAbort then
  551.         Exit;
  552.     until not Locked;
  553.     if not IsamOK then
  554.       IsamErrorNum(IsamError)
  555.     else
  556.       EraseKey := True;
  557.   end;
  558.  
  559.   function ModKey(AltK, NeuK : IsamKeyStr; Rec : LongInt; KeyNr : Integer) : Boolean;
  560.     {-Replace a key}
  561.   begin
  562.     ModKey := False;
  563.     if EraseKey(AltK, Rec, KeyNr) then
  564.       if AddKey(NeuK, Rec, KeyNr) then
  565.         ModKey := True;
  566.   end;
  567.  
  568.   procedure Reposition(UserKey : IsamKeyStr);
  569.     {-Set sequential file pointer to another key}
  570.   var
  571.     Rec : LongInt;
  572.   begin
  573.     repeat
  574.       FindNetKey(Pf, 1, Rec, UserKey);
  575.       if LockAbort then
  576.         Exit;
  577.     until not Locked;
  578.     if not IsamOK then
  579.       ActRec := 0;
  580.   end;
  581.  
  582.   function LockAll : Boolean;
  583.     {-Lock all open files, returning true if successful}
  584.   var
  585.     OK : Boolean;
  586.   begin
  587.     LockAll := False;
  588.     repeat
  589.       LockAllOpenFileBlocks;
  590.       if not IsamOK then begin
  591.         if not YesNo('The file is presently in use. Try again?', 'Y') then
  592.           Exit;
  593.         OK := False;
  594.       end
  595.       else
  596.         OK := True;
  597.     until OK;
  598.     LockAll := True;
  599.   end;
  600.  
  601.   procedure NewStructure;
  602.     {-Prompt for and add new record}
  603.   label
  604.     Retry;
  605.   var
  606.     PersonTemp : PersonDef;
  607.     Key1, Key2 : IsamKeyStr;
  608.     Rec : LongInt;
  609.     KExists, OK : Boolean;
  610.   begin
  611.     WriteHeader(' New Entry ', True);
  612.     ClearPerson(PersonTemp);
  613.  
  614. Retry:
  615.     {Get the new record}
  616.     if not GetPerson(PersonTemp, True, 'Add Record', 0) then
  617.       Exit;
  618.  
  619.     {make the index keys}
  620.     Key1 := BuildKey(PersonTemp, 1);
  621.     Key2 := BuildKey(PersonTemp, 2);
  622.  
  623.     {Lock the database in order to safely add the record}
  624.     if not LockAll then
  625.       Exit;
  626.  
  627.     {Assure it's not a duplicate key}
  628.     repeat
  629.       KExists := NetKeyExists(Pf, 1, Rec, Key1);
  630.       if LockAbort then begin
  631.         UnLockAllOpenFileBlocks;
  632.         Exit;
  633.       end;
  634.     until not Locked;
  635.     if KExists then begin
  636.       UnLockAllOpenFileBlocks;
  637.       if not YesNo('The name already exists. Try again?', 'Y') then
  638.         Exit
  639.       else
  640.         goto Retry;
  641.     end;
  642.  
  643.     {Add the record and its keys}
  644.     OK := AddStructure(PersonTemp, Rec);
  645.     if OK then
  646.       OK := AddKey(Key1, Rec, 1);
  647.     if OK then
  648.       OK := AddKey(Key2, Rec, 2);
  649.  
  650.     {$IFDEF Novell}
  651.     if NetSupported = Novell then begin
  652.       Sync.IndicateDirty(1);
  653.       Sync.IndicateDirty(2);
  654.     end;
  655.     {$ENDIF}
  656.  
  657.     {Save global pointers to the current record}
  658.     if OK then begin
  659.       ActRec := Rec;
  660.       case ActKeyNr of
  661.         1 : ActKey := Key1;
  662.         2 : ActKey := Key2;
  663.       end;
  664.       VB.SetCurrentRecord(ActKey, ActRec);
  665.     end;
  666.  
  667.     UnLockAllOpenFileBlocks;
  668.   end;
  669.  
  670.   procedure Modify;
  671.     {-Modify an existing record}
  672.   label
  673.     Retry;
  674.   var
  675.     PersonTemp : PersonDef;
  676.     PersonTemp1 : PersonDef;
  677.     KExists, OK : Boolean;
  678.     Rec : LongInt;
  679.     Escaped : Boolean;
  680.     NoChanges : Boolean;
  681.   begin
  682.     WriteHeader(' Modify ', True);
  683.     PersonTemp := Person;
  684.  
  685. Retry:
  686.     Escaped := not GetPerson(PersonTemp, True, 'Modifying', ActRec);
  687.     NoChanges := CompPerson(Person, PersonTemp);
  688.     if Escaped and not NoChanges then
  689.       NoChanges := YesNo('Ignore changes to record?', 'N');
  690.     if NoChanges then begin
  691.       DispMessageTemp('Files not changed.', 250);
  692.       Exit;
  693.     end;
  694.  
  695.     {Lock the database in order to safely modify the record}
  696.     if not LockAll then
  697.       Exit;
  698.  
  699.     if BuildKey(PersonTemp, 1) <> BuildKey(Person, 1) then begin
  700.       KExists := NetKeyExists(Pf, 1, ActRec, BuildKey(PersonTemp, 1));
  701.       if not IsamOK then begin
  702.         IsamErrorNum(IsamError);
  703.         UnLockAllOpenFileBlocks;
  704.         Exit;
  705.       end;
  706.       if KExists then begin
  707.         UnLockAllOpenFileBlocks;
  708.         if not YesNo('The name already exists. Try again?', 'Y') then
  709.           Exit
  710.         else
  711.           goto Retry;
  712.       end;
  713.     end;
  714.  
  715.     Rec := ActRec;
  716.     {Read actual disk data}
  717.     GetVariableRec(Pf, Rec, PersonTemp1, VRecLen, Normal);
  718.     if not IsamOK then begin
  719.       UnLockAllOpenFileBlocks;
  720.       DispMessageTemp('Record could not be read from disk.', 1000);
  721.       Exit;
  722.     end;
  723.  
  724.     if PersonTemp1.Dele <> LongInt(0) then begin
  725.       UnLockAllOpenFileBlocks;
  726.       DispMessageTemp('The record has been erased in the meantime.', 1000);
  727.       Exit;
  728.     end;
  729.  
  730.     if not CompPerson(PersonTemp1, Person) then begin
  731.       UnLockAllOpenFileBlocks;
  732.       DispMessageTemp('The record has been changed in the meantime.', 1000);
  733.       Person := PersonTemp1;
  734.       Exit;
  735.     end;
  736.  
  737.     OK := ModStructure(PersonTemp, ActRec);
  738.     if OK then
  739.       if BuildKey(PersonTemp, 1) <> BuildKey(Person, 1) then begin
  740.         OK := ModKey(BuildKey(Person, 1), BuildKey(PersonTemp, 1), ActRec, 1);
  741.         if OK then
  742.           Reposition(BuildKey(PersonTemp, 1));
  743.       end;
  744.     if OK then
  745.       if BuildKey(PersonTemp, 2) <> BuildKey(Person, 2) then
  746.         OK := ModKey(BuildKey(Person, 2), BuildKey(PersonTemp, 2), ActRec, 2);
  747.  
  748.     UnLockAllOpenFileBlocks;
  749.     if OK then begin
  750.       Person := PersonTemp;
  751.       VB.SetCurrentRecord(BuildKey(Person, ActKeyNr), ActRec);
  752.       {$IFDEF Novell}
  753.       if NetSupported = Novell then begin
  754.         Sync.IndicateDirty(1);
  755.         Sync.IndicateDirty(2);
  756.       end;
  757.       {$ENDIF}
  758.     end;
  759.   end;
  760.  
  761.   procedure Delete;
  762.     {-Prompt for and delete a record}
  763.   var
  764.     Key1, Key2 : IsamKeyStr;
  765.     OK, Del : Boolean;
  766.   begin
  767.     WriteHeader(' Deleting ', True);
  768.     DisplayPerson(Person, 'Deleting', ActRec);
  769.     Del := YesNo('Should the record really be deleted?', 'N');
  770.     EraseWindows;
  771.     if not Del then
  772.       Exit;
  773.  
  774.     Key1 := BuildKey(Person, 1);
  775.     Key2 := BuildKey(Person, 2);
  776.  
  777.     {Lock the database}
  778.     if not LockAll then
  779.       Exit;
  780.  
  781.     OK := EraseKey(Key1, ActRec, 1);
  782.     if OK then
  783.       OK := EraseKey(Key2, ActRec, 2);
  784.     if OK then
  785.       OK := DelStructure(ActRec);
  786.     if not OK then
  787.       IsamErrorNum(IsamError);
  788.  
  789.     {$IFDEF Novell}
  790.     if OK and (NetSupported = Novell) then begin
  791.       Sync.IndicateDirty(1);
  792.       Sync.IndicateDirty(2);
  793.     end;
  794.     {$ENDIF}
  795.  
  796.     UnLockAllOpenFileBlocks;
  797.   end;
  798.  
  799.   function MatchString(var SG, ST : String) : Boolean;
  800.     {-Return true if SG and ST match}
  801.   begin
  802.     if Length(SG) = 0 then
  803.       {Nothing to match against}
  804.       MatchString := True
  805.     else
  806.       {Match if ST starts with SG}
  807.       MatchString := (Pos(StUpCase(SG), StUpCase(ST)) = 1);
  808.   end;
  809.  
  810.   function MatchPerson(var PG, PT : PersonDef) : Boolean;
  811.     {-Compare two person records}
  812.   begin
  813.     MatchPerson := False;
  814.     if PT.Dele <> 0 then
  815.       Exit;
  816.     if not MatchString(PG.FirstName, PT.FirstName) then
  817.       Exit;
  818.     if not MatchString(PG.Name, PT.Name) then
  819.       Exit;
  820.     if not MatchString(PG.Company, PT.Company) then
  821.       Exit;
  822.     if not MatchString(PG.Address, PT.Address) then
  823.       Exit;
  824.     if not MatchString(PG.City, PT.City) then
  825.       Exit;
  826.     if not MatchString(PG.State, PT.State) then
  827.       Exit;
  828.     if not MatchString(PG.Zip, PT.Zip) then
  829.       Exit;
  830.     if not MatchString(PG.Telephone, PT.Telephone) then
  831.       Exit;
  832.     MatchPerson := True;
  833.   end;
  834.  
  835.   function GetNextRec(var Fptr       : IsamFileBlockPtr;
  836.                       var Data       : PersonDef;
  837.                       KeyNr          : Integer;
  838.                       var Rec        : LongInt;
  839.                       var UserKey    : IsamKeyStr) : Boolean;
  840.     {-Get next record in index order}
  841.   begin
  842.     GetNextRec := False;
  843.  
  844.     {Get next sequential key}
  845.     repeat
  846.       NextNetKey(Fptr, KeyNr, Rec, UserKey);
  847.       if LockAbort then
  848.         Exit;
  849.     until not Locked;
  850.  
  851.     if not IsamOK and (IsamError = 10250) then
  852.       {At end of list, try once more to wrap to beginning}
  853.       repeat
  854.         NextNetKey(Fptr, KeyNr, Rec, UserKey);
  855.         if LockAbort then
  856.           Exit;
  857.       until not Locked
  858.     else
  859.       GetNextRec := True;
  860.     if not IsamOK then
  861.       Exit;
  862.  
  863.     {Get associated data}
  864.     repeat
  865.       GetVariableRec(Fptr, Rec, Data, VRecLen, Normal);
  866.       if LockAbort then
  867.         Exit;
  868.     until not Locked;
  869.   end;
  870.  
  871.   procedure Search;
  872.     {-Search for a record}
  873.   var
  874.     R : LongInt;
  875.     SearchKey : Integer;
  876.     OK : Boolean;
  877.     Found : Boolean;
  878.     Key : IsamKeyStr;
  879.     PersonGoal : PersonDef;
  880.     PersonTemp : PersonDef;
  881.  
  882.     procedure NotFoundMessage;
  883.     begin
  884.       DispMessage('No matching record found', True, True);
  885.     end;
  886.  
  887.   begin
  888.     WriteHeader(' Search Key ', True);
  889.     ClearPerson(PersonGoal);
  890.     ClearPerson(PersonTemp);
  891.  
  892.     {Get search target}
  893.     ValidationOff := True;
  894.     if not GetPerson(PersonGoal, False, 'Search', 0) or
  895.     CompPerson(PersonTemp, PersonGoal) then
  896.       {Nothing entered}
  897.       Exit;
  898.  
  899.     WriteFooter('Searching... ');
  900.  
  901.     {See which key to search on, if any}
  902.     if Length(PersonGoal.Name) <> 0 then
  903.       SearchKey := 1
  904.     else if Length(PersonGoal.Zip) <> 0 then
  905.       SearchKey := 2
  906.     else
  907.       SearchKey := 0;
  908.  
  909.     if SearchKey <> 0 then begin
  910.       {Use the index system to position to the nearest record}
  911.       Key := BuildKey(PersonGoal, SearchKey);
  912.       repeat
  913.         SearchNetKey(Pf, SearchKey, R, Key);
  914.         if LockAbort then
  915.           Exit;
  916.       until not Locked;
  917.       if not IsamOK then begin
  918.         if IsamError = 10210 then
  919.           NotFoundMessage
  920.         else
  921.           IsamErrorNum(IsamError);
  922.         Exit;
  923.       end;
  924.  
  925.       {Get the record}
  926.       repeat
  927.         GetVariableRec(Pf, R, PersonTemp, VRecLen, Normal);
  928.         if LockAbort then
  929.           Exit;
  930.       until not Locked;
  931.  
  932.       {Position current record pointer at least near to the goal}
  933.       ActRec := R;
  934.       ActKey := BuildKey(PersonTemp, ActKeyNr);
  935.  
  936.       {Does it match the goal?}
  937.       Found := MatchPerson(PersonGoal, PersonTemp);
  938.     end
  939.     else begin
  940.       {Start sequential search at the currently active record}
  941.       R := ActRec;
  942.       FindNetKeyAndRef(Pf, ActKeyNr, R, ActKey, 0);
  943.       Found := False;
  944.     end;
  945.  
  946.     if not Found then begin
  947.       {Sequential search, starting one beyond current position}
  948.       if SearchKey = 0 then
  949.         SearchKey := ActKeyNr;
  950.       repeat
  951.         OK := GetNextRec(Pf, PersonTemp, SearchKey, R, Key);
  952.         if not IsamOK then
  953.           Exit;
  954.         Found := MatchPerson(PersonGoal, PersonTemp);
  955.       until Found or (R = ActRec);
  956.     end;
  957.  
  958.     if Found then begin
  959.       ActRec := R;
  960.       ActKey := BuildKey(PersonTemp, ActKeyNr);
  961.       VB.SetCurrentRecord(ActKey, ActRec);
  962.     end
  963.     else
  964.       NotFoundMessage;
  965.   end;
  966.  
  967.   procedure Status;
  968.     {-Show the number of records}
  969.   const
  970.     ModeSt : array[OpenMode] of string[6] = ('Normal', 'Save');
  971.   var
  972.     F, U, K : LongInt;
  973.   begin
  974.     WriteHeader(' Status ', True);
  975.     repeat
  976.       U := UsedNetRecs(Pf);
  977.       if LockAbort then
  978.         Exit;
  979.     until not Locked;
  980.  
  981.     repeat
  982.       F := FreeNetRecs(Pf);
  983.       if LockAbort then
  984.         Exit;
  985.     until not Locked;
  986.     {$IFNDEF UseFiler500}
  987.     repeat
  988.       K := UsedNetKeys(Pf, 1);
  989.       if LockAbort then
  990.         Exit;
  991.     until not Locked;
  992.     {$ELSE}
  993.     K := U;
  994.     {$ENDIF}
  995.     DispMessage(
  996.       'Records:'+Long2Str(K)+
  997.       ', Sections:'+Long2Str(U)+
  998.       ', Deleted:'+Long2Str(F)+
  999.       ', Mode:'+ModeSt[Mode]+
  1000.       ', Station:'+Long2Str(IsamWSNr),
  1001.       True, False);
  1002.   end;
  1003.  
  1004.   procedure List;
  1005.     {-List all records to printer}
  1006.   var
  1007.     T     : LongInt;
  1008.     Rec   : LongInt;
  1009.     KeyNr : Integer;
  1010.     Key   : IsamKeyStr;
  1011.     OK    : Boolean;
  1012.     C     : Char;
  1013.     Lst   : Text;
  1014.     S     : String;
  1015.     SLen  : Byte absolute S;
  1016.   begin
  1017.     WriteHeader(' List ', True);
  1018.  
  1019.     {Assure there are records to print}
  1020.     repeat
  1021.       T := UsedNetRecs(Pf);
  1022.       if LockAbort then
  1023.         Exit;
  1024.     until not Locked;
  1025.     if T = 0 then begin
  1026.       DispMessage('No records available', True, True);
  1027.       Exit;
  1028.     end;
  1029.  
  1030.     {See what order to print in -- provide chance to abort}
  1031.     C := Menu('NZA', 'Sort by  N)ame Z)ipcode A)bort');
  1032.     case C of
  1033.       'A' : Exit;
  1034.       'N' : KeyNr := 1;
  1035.       'Z' : KeyNr := 2;
  1036.     end;
  1037.  
  1038.     {Position over first record}
  1039.     repeat
  1040.       ClearNetKey(Pf, KeyNr);
  1041.       if LockAbort then
  1042.         Exit;
  1043.     until not Locked;
  1044.     Rec := 0;
  1045.     Key := '';
  1046.     if IsamOK then begin
  1047.       OK := GetNextRec(Pf, Person, KeyNr, Rec, Key);
  1048.       if Locked then
  1049.         Exit;
  1050.  
  1051.       {Print all the records}
  1052.       Assign(Lst, LstDevice);
  1053.       Rewrite(Lst);
  1054.       if IoResult <> 0 then begin
  1055.         DispMessage('Error attempting to write to '+LstDevice,True,True);
  1056.         Exit;
  1057.       end;
  1058.  
  1059.       AbortPrintMessage;
  1060.       repeat
  1061.         {get displayable string and trim checkmarks and blanks}
  1062.         S := PersonLine(Person);
  1063.         if S[SLen] = #251 then
  1064.           Dec(SLen);
  1065.         while S[SLen] = ' ' do
  1066.           Dec(SLen);
  1067.  
  1068.         WriteLn(Lst, S);
  1069.         OK := (IoResult = 0);
  1070.         if OK then
  1071.           OK := not Aborting
  1072.         else
  1073.           DispMessage('Printer error', True, True);
  1074.         if OK then
  1075.           OK := GetNextRec(Pf, Person, KeyNr, Rec, Key);
  1076.         if Locked then
  1077.           OK := False;
  1078.       until not(IsamOK and OK);
  1079.       Close(Lst);
  1080.       if IoResult <> 0 then ;   {clear IoResult}
  1081.     end;
  1082.   end;
  1083.  
  1084.   function Long2StrDigits(L : LongInt; NumDigits : Byte) : String;
  1085.   {-Convert a longint to a string, right justified to NumDigits}
  1086.   var
  1087.     S : String;
  1088.   begin
  1089.     Str(L:NumDigits,S);
  1090.     Long2StrDigits := S;
  1091.   end;
  1092.  
  1093.   {$F+}
  1094.   procedure UserStatusRoutine(KeyNr : Integer;
  1095.                               NumRecsRead,
  1096.                               NumRecsWritten : LongInt;
  1097.                               var Data;
  1098.                               Len : Word);
  1099.   {-Display information while rebuilding database}
  1100.   var
  1101.     StatStr : String[80];
  1102.   begin
  1103.     StatStr := 'Working on key --> '+Long2StrDigits(KeyNr,1)+
  1104.                '   records read --> '+Long2StrDigits(NumRecsRead,6)+
  1105.                '   written --> '+Long2StrDigits(NumRecsWritten,6);
  1106.     WriteFooter(StatStr);
  1107.   end;
  1108.   {$F-}
  1109.  
  1110.   function Reconstruct : Boolean;
  1111.     {-Reconstruct the database from the datafile}
  1112.   var
  1113.     IID : IsamIndDescr;
  1114.   begin
  1115.     IID[1].KeyL := Key1Len;
  1116.     IID[1].AllowDupK := False;
  1117.     IID[2].KeyL := Key2Len;
  1118.     IID[2].AllowDupK := True;
  1119.     {$IFNDEF UseFiler500}
  1120.     IsamRexUserProcPtr := @UserStatusRoutine;  {set user status procedure}
  1121.     {$ENDIF}
  1122.     RebuildVFileBlock(FName, SectionLength, 2, IID, @BuildKey);
  1123.     Reconstruct := IsamOK;
  1124.   end;
  1125.  
  1126.   function OpenedFiles : Boolean;
  1127.     {-Try to open existing database files}
  1128.   var
  1129.     OK, OK1 : Boolean;
  1130.   begin
  1131.     OpenedFiles := False;
  1132.     repeat
  1133.       if Mode = NormalMode then
  1134.         OpenNetFileBlock(Pf, FName)
  1135.       else
  1136.         OpenSaveNetFileBlock(Pf, FName);
  1137.       OK := IsamOK;
  1138.       if not IsamOK then begin
  1139.         if IsamError = 10010 then begin
  1140.           if YesNo('Index file defective. Rebuild it?', 'Y') then
  1141.             OK1 := Reconstruct
  1142.           else
  1143.             Exit;
  1144.         end
  1145.         else if IsamError = 9903 then begin
  1146.           if YesNo('Data file does not exist. Create new one?', 'Y') then begin
  1147.             if not CreateFile then
  1148.               Exit;
  1149.             CloseNetFileBlock(Pf);
  1150.           end
  1151.           else
  1152.             Exit;
  1153.         end
  1154.         else begin
  1155.           if YesNo('Data error '+Long2Str(IsamError)+'. Attempt rebuild?', 'Y') then
  1156.             OK1 := Reconstruct
  1157.           else
  1158.             Exit;
  1159.         end;
  1160.       end;
  1161.     until OK;
  1162.     OpenedFiles := True;
  1163.   end;
  1164.  
  1165.   procedure SwitchKeys;
  1166.     {-Make the other key active}
  1167.   begin
  1168.     ActKeyNr := (ActKeyNr and 1)+1;
  1169.     ActKey := BuildKey(Person, ActKeyNr);
  1170.     VB.SetKeyNumber(ActKeyNr);
  1171.     VB.SetCurrentRecord(ActKey, ActRec);
  1172.   end;
  1173.  
  1174.   {---------------------------filtering hooks-----------------------------
  1175.     The following routine is used to implement the special filtering
  1176.     capabilites of FBDEMO. When the F6 key is pressed, the user is
  1177.     prompted for information to be used to determine what records should
  1178.     appear in the browser.
  1179.   ------------------------------------------------------------------------}
  1180.   {$F+}
  1181.   function ValidatePerson(Ref : LongInt; Key : IsamKeyStr;
  1182.                           FBP : FBrowserPtr) : Boolean;
  1183.     {-Validate a data record against the current Browser filter}
  1184.   begin
  1185.     FBP^.GetRecord(Ref, Person, DatLen);
  1186.     if not IsamOK then
  1187.       ValidatePerson := False
  1188.     else
  1189.       {is it a match?}
  1190.       ValidatePerson := MatchPerson(PersonFilter, Person);
  1191.   end;
  1192.   {$F-}
  1193.  
  1194.   procedure Filter;
  1195.     {-Prompt for information used by Browser filtering routines}
  1196.   var
  1197.     PersonGoal, PersonTemp : PersonDef;
  1198.   begin
  1199.     WriteHeader(' Filtering Info ', True);
  1200.  
  1201.     {cancel existing filter}
  1202.     VB.SetFilterFunc(NullFilterFunc);
  1203.  
  1204.     ClearPerson(PersonTemp);
  1205.     ClearPerson(PersonGoal);
  1206.  
  1207.     {get filtering information}
  1208.     if GetPerson(PersonGoal, False, 'Filter', 0) then
  1209.       {did user enter anything?}
  1210.       if not CompPerson(PersonTemp, PersonGoal) then
  1211.         {confirm that user desires filtering}
  1212.         if YesNo('Enable filtering with this information?', 'Y') then begin
  1213.           PersonFilter := PersonGoal;
  1214.           VB.SetFilterFunc(ValidatePerson);
  1215.         end;
  1216.   end;
  1217.  
  1218.   procedure RebuildData;
  1219.     {-Purge deleted records and rebuild indices}
  1220.   begin
  1221.     WriteHeader(' Rebuild ', True);
  1222.     WriteFooter('Please wait... ');
  1223.     CloseNetFileBlock(Pf);
  1224.     if not IsamOK then begin
  1225.       IsamErrorNum(IsamError);
  1226.       Halt;
  1227.     end;
  1228.     if not Reconstruct then begin
  1229.       DispMessage('Unable to rebuild data files', True, True);
  1230.       Halt;
  1231.     end;
  1232.     if not OpenedFiles then begin
  1233.       IsamErrorNum(IsamError);
  1234.       Halt;
  1235.     end;
  1236.     EnableSearchForSequential(Pf, 1);
  1237.     EnableSearchForSequential(Pf, 2);
  1238.     ActRec := 0;
  1239.     ActKeyNr := 1;
  1240.     ActKey := '';
  1241.   end;
  1242.  
  1243. {$F+}
  1244.   procedure ErrorHandler(UnitCode : Byte; var ErrCode : Word; Msg : String);
  1245.     {-Display messages for errors reported by OPENTRY/OPMEMO/FBROWSE}
  1246.   var
  1247.     P : Pointer;
  1248.   begin
  1249.     {try to save underlying text}
  1250.     if not SaveWindow(1, ScreenHeight, ScreenWidth, ScreenHeight, True, P) then begin
  1251.       RingBell;
  1252.       Exit;
  1253.     end;
  1254.  
  1255.     if Msg = '' then
  1256.       Msg := 'Unknown error: '+Long2Str(ErrCode);
  1257.  
  1258.     {display the error message}
  1259.     if ErrCode = epFatal+ecIsamError then
  1260.       IsamErrorNum(IsamError)
  1261.     else
  1262.       DispMessage(Msg, True, True);
  1263.  
  1264.     {restore underlying text}
  1265.     RestoreWindow(1, ScreenHeight, ScreenWidth, ScreenHeight, True, P);
  1266.   end;
  1267.  
  1268.   procedure PreEdit(ESP : EntryScreenPtr);
  1269.     {-Display a help prompt for the current field}
  1270.   var
  1271.     S : String[40];
  1272.   begin
  1273.     case ESP^.GetCurrentID of
  1274.       idFirstName : S := 'Enter first name';
  1275.       idLastName  : S := 'Enter last name';
  1276.       idCompany   : S := 'Enter company name';
  1277.       idAddress   : S := 'Enter street address';
  1278.       idCity      : S := 'Enter city of residence';
  1279.       idState     : S := 'Enter state of residence';
  1280.       idZipCode   : S := 'Enter a 5- or 9-digit zip code';
  1281.       idPhone     : S := 'Enter phone number';
  1282.       idNotes     : S := 'Press <Enter> to edit memo field';
  1283.     end;
  1284.     WriteFooter(' <^Enter> Done  <Esc> Abort  '+S);
  1285.   end;
  1286.  
  1287.   procedure MemoFieldStatus(MP : MemoPtr);
  1288.     {-Display status line for memo field}
  1289.   const
  1290.     StatusLine : String[48] =
  1291.     {         1         2         3         4        }
  1292.     {123456789012345678901234567890123456789012345678}
  1293.     ' Line: xxx Column: xxx 100%  Insert Indent Wrap ';
  1294.     InsertSt : array[Boolean] of String[6] = (' Over ', 'Insert');
  1295.     IndentSt : array[Boolean] of String[6] = ('      ', 'Indent');
  1296.     WrapSt   : array[Boolean] of String[4] = ('    ', 'Wrap');
  1297.   var
  1298.     S  : String[5];
  1299.     {$IFDEF UseMouse}
  1300.     SaveMouse : Boolean;
  1301.     {$ENDIF}
  1302.   begin
  1303.     with FbColors, MP^ do begin
  1304.       {insert line number}
  1305.       S := Long2Str(meCurLine);
  1306.       S := Pad(S, 3);
  1307.       Move(S[1], StatusLine[8], 3);
  1308.  
  1309.       {insert column number}
  1310.       S := Long2Str(meCurCol);
  1311.       S := Pad(S, 3);
  1312.       Move(S[1], StatusLine[20], 3);
  1313.  
  1314.       {insert percentage of buffer used}
  1315.       S := Real2Str(Trunc((meTotalBytes*100.0)/(meBufSize-2)), 3, 0);
  1316.       Move(S[1], StatusLine[24], 3);
  1317.  
  1318.       {plug in state stuff}
  1319.       Move(InsertSt[meOptionsAreOn(meInsert)][1], StatusLine[30], 6);
  1320.       Move(IndentSt[meOptionsAreOn(meIndent)][1], StatusLine[37], 6);
  1321.       Move(WrapSt[meOptionsAreOn(meWordWrap)][1], StatusLine[44], 4);
  1322.  
  1323.       {$IFDEF UseMouse}
  1324.       HideMousePrim(SaveMouse);
  1325.       {$ENDIF}
  1326.  
  1327.       {display status line}
  1328.       FastWrite(
  1329.         StatusLine, MemoYH+1, MemoXL+1, ColorMono(PromptColor, PromptMono));
  1330.  
  1331.       {$IFDEF UseMouse}
  1332.       ShowMousePrim(SaveMouse);
  1333.       {$ENDIF}
  1334.     end;
  1335.   end;
  1336.  
  1337. {$F-}
  1338.  
  1339.   procedure InitEntryScreen;
  1340.     {-Set up for data entry screens}
  1341.   const
  1342.     Options     = wClear+wBordered;
  1343.     NameMask    = 'xxxxxxxxxxxxxxx';
  1344.     CompanyMask = 'xxxxxxxxxxxxxxxxxxxxxxxxx';
  1345.     NotesMsg    : string[1] = #14;
  1346.   begin
  1347.     {clear the scrap record used for editing}
  1348.     ClearPerson(ScrapPerson);
  1349.  
  1350.     {.F-}
  1351.     {initialize the entry screen}
  1352.     if not ES.InitCustom(EntryXL,          {left column of window}
  1353.                          EntryYL,          {top row of window}
  1354.                          EntryXH,          {right column of window}
  1355.                          EntryYH,          {bottom row of window}
  1356.                          FbColors,         {color set}
  1357.                          Options)          {window options}
  1358.     then
  1359.       Abort;
  1360.  
  1361.     {add dummy header}
  1362.     ES.wFrame.AddHeader(' dummy ', heTC);
  1363.  
  1364.     {set field delimiters}
  1365.     ES.SetDelimiters('[', ']');
  1366.  
  1367.     {set entry screen options}
  1368.     ES.SetWrapMode(WrapAtEdges);
  1369.  
  1370.     {set field editing options}
  1371.     ES.esFieldOptionsOn(efBeepOnError+efClearFirstChar);
  1372.  
  1373.     {add each of the edit fields in order: left to right, top to bottom}
  1374.     {               Prompt               ---Field--- Help              }
  1375.     { Prompt        Row Col Picture      Row Col Len Index     Variable}
  1376.  
  1377.     ES.AddStringField(
  1378.       'First name', 01, 05, NameMask,    01, 21, 15, 00, ScrapPerson.FirstName);
  1379.  
  1380.     ES.AddStringField(
  1381.       'Last name',  02, 05, NameMask,    02, 21, 15, 01, ScrapPerson.Name);
  1382.  
  1383.     ES.AddStringField(
  1384.       'Company',    03, 05, CompanyMask, 03, 21, 25, 02, ScrapPerson.Company);
  1385.  
  1386.     ES.AddStringField(
  1387.       'Address',    04, 05, CompanyMask, 04, 21, 25, 03, ScrapPerson.Address);
  1388.  
  1389.     ES.AddStringField(
  1390.       'City',       05, 05, NameMask,    05, 21, 15, 04, ScrapPerson.City);
  1391.  
  1392.     ES.AddStringField(
  1393.       'State',      06, 05, 'AA',        06, 21, 02, 05, ScrapPerson.State);
  1394.     ES.ChangeValidation(idState, ValidateState);
  1395.  
  1396.     ES.AddStringField(
  1397.       'Zip',        07, 05, ZipMask,     07, 21, 10, 06, ScrapPerson.Zip);
  1398.     ES.ChangeConversion(idZipCode, PhoneZipConversion);
  1399.     ES.ChangeValidation(idZipCode, ValidateZip);
  1400.  
  1401.     ES.AddStringField(
  1402.       'Telephone',  08, 05, PhoneMask,   08, 21, 12, 07, ScrapPerson.Telephone);
  1403.     ES.ChangeConversion(idPhone, PhoneZipConversion);
  1404.     ES.ChangeValidation(idPhone, ValidatePhone);
  1405.  
  1406.     ES.esFieldOptionsOff(efMapCtrls);
  1407.     ES.AddNestedStringField(
  1408.       'Notes',      09, 05, '',          09, 21, 01, 08, NotesMsg);
  1409.     {.F+}
  1410.  
  1411.     {install user-written event handlers}
  1412.     ES.SetPreEditProc(PreEdit);
  1413.     ES.SetErrorProc(ErrorHandler);
  1414.  
  1415.     {check for error}
  1416.     if ES.GetLastError <> 0 then
  1417.       Abort;
  1418.   end;
  1419.  
  1420.   procedure InitMemoFields;
  1421.     {-Set up for memo fields}
  1422.   const
  1423.     Options = wClear+wBordered;
  1424.   begin
  1425.     {deactivate <Esc>, use <^Enter> instead}
  1426.     MemoCommands.AddCommand(ccNone, 1, Ord(^[), 0);
  1427.     MemoCommands.AddCommand(ccQuit, 1, Ord(^J), 0);
  1428.  
  1429.     {.F-}
  1430.     {initialize the memo}
  1431.     if not M.InitCustom(MemoXL,                {left column of window}
  1432.                         MemoYL,                {top row of window}
  1433.                         MemoXH,                {right column of window}
  1434.                         MemoYH,                {bottom row of window}
  1435.                         FbColors,              {color set}
  1436.                         Options,               {window options}
  1437.                         SizeOf(MemoField),     {size of edit buffer}
  1438.                         @ScrapPerson.Notes)    {edit buffer}
  1439.     then
  1440.       Abort;
  1441.     {.F+}
  1442.  
  1443.     {add dummy header}
  1444.     M.wFrame.AddHeader(' Notes ', heTC);
  1445.  
  1446.     {set right margin}
  1447.     M.SetRightMargin(MemoXH-MemoXL);
  1448.  
  1449.     {install user-written event handlers}
  1450.     M.SetStatusProc(MemoFieldStatus);
  1451.     M.SetErrorProc(ErrorHandler);
  1452.  
  1453.     {check for error}
  1454.     if M.GetLastError <> 0 then
  1455.       Abort;
  1456.   end;
  1457.  
  1458.   procedure InitBrowser;
  1459.     {-Set up for browsing}
  1460.   const
  1461.     {$IFDEF UseAdjustableWindows}
  1462.     Options = wClear+wBordered+wResizeable;
  1463.     {$ELSE}
  1464.     Options = wClear+wBordered;
  1465.     {$ENDIF}
  1466.   {$IFDEF TestStream}
  1467.   var
  1468.     S : BufIdStream;
  1469.   {$ENDIF}
  1470.   begin
  1471.     {add user-defined exit commands}
  1472.     with FBrowserCommands do begin
  1473.       AddCommand(ccUser2,  1, F2,   0); {add record}
  1474.       AddCommand(ccUser3,  1, F3,   0); {delete record}
  1475.       AddCommand(ccUser4,  1, F4,   0); {search}
  1476.       AddCommand(ccUser5,  1, F5,   0); {switch keys}
  1477.       AddCommand(ccUser6,  1, F6,   0); {filter}
  1478.       AddCommand(ccUser8,  1, F8,   0); {print records}
  1479.       AddCommand(ccUser9,  1, F9,   0); {show status}
  1480.       AddCommand(ccUser10, 1, F10,  0); {purge}
  1481.       {$IFDEF UseAdjustableWindows}
  1482.       AddCommand(ccUser11, 1, AltR, 0); {resize window}
  1483.       AddCommand(ccUser12, 1, AltM, 0); {move window}
  1484.       AddCommand(ccUser13, 1, AltZ, 0); {zoom window}
  1485.       {$ENDIF}
  1486.     end;
  1487.  
  1488.     {initialize the browser}
  1489.     if not VB.InitCustom(3,              {left column of window}
  1490.                          5,              {top row of window}
  1491.                        {$IFDEF UseShadows}
  1492.                          ScreenWidth-3,  {right column of window}
  1493.                        {$ELSE}
  1494.                          ScreenWidth-2,  {right column of window}
  1495.                        {$ENDIF}
  1496.                          ScreenHeight-3, {bottom row of window}
  1497.                          FbColors,       {color set}
  1498.                          Options,        {window options}
  1499.                          Pf,             {fileblock}
  1500.                          ActKeyNr,       {key number}
  1501.                          Person,         {scrap variable}
  1502.                          ScreenHeight-5, {maximum rows}
  1503.                          RowsPerItem,    {rows per item}
  1504.                          MaxCols)        {maximum columns}
  1505.     then
  1506.       Abort;
  1507.  
  1508.     {adjust frame coordinates}
  1509.     with VB do begin
  1510.       {$IFDEF UseAdjustableWindows}
  1511.       {set the limits to use when moving/zooming/resizing the window}
  1512.       SetPosLimits(1, 2, ScreenWidth, ScreenHeight-1);
  1513.       {$ENDIF}
  1514.  
  1515.       with wFrame do begin
  1516.         AdjustFrameCoords(frXL, frYL-1, frXH, frYH);
  1517.  
  1518.         {$IFDEF UseScrollBars}
  1519.         {add scroll bars}
  1520.         AddCustomScrollBar(frBB, 0, MaxLongInt, 1, 1, #178, #176, fbColors);
  1521.         AddCustomScrollBar(frRR, 0, MaxLongInt, 1, 1, #178, #176, fbColors);
  1522.         {$ENDIF}
  1523.  
  1524.         {$IFDEF UseShadows}
  1525.         AddShadow(shBR, shSeeThru);
  1526.         {$ENDIF}
  1527.       end;
  1528.     end;
  1529.  
  1530.     {install user-written event handlers}
  1531.     VB.SetBuildItemProc(BuildRow);
  1532.     VB.SetScreenUpdateProc(UpdateScreen);
  1533.     VB.SetErrorProc(ErrorHandler);
  1534.  
  1535.     {$IFDEF Novell}
  1536.     if NetSupported = Novell then begin
  1537.       VB.SetRefreshFunc(SemaphoreRefresh);
  1538.       RefreshPeriod := 18 div 2;
  1539.     end
  1540.     else
  1541.       VB.SetRefreshFunc(RefreshPeriodically);
  1542.     {$ELSE}
  1543.     VB.SetRefreshFunc(RefreshPeriodically);
  1544.     {$ENDIF}
  1545.  
  1546.     {options}
  1547.     VB.fbOptionsOn(fbFlushKbd);
  1548.  
  1549.     {you might want to try uncommenting one or more of the following:}
  1550.     { VB.fbOptionsOn(fbBellOnFlush); }
  1551.     { VB.SetKeyRange('C'#0, 'K'#255); }
  1552.     { VB.fbOptionsOff(fbAutoScale); }
  1553.     { VB.fbOptionsOff(fbDrawActive); }
  1554.     { VB.fbOptionsOn(fbScrollByPage); }
  1555.     { VB.SetHorizScrollDelta(10); }
  1556.     { VB.SetVertScrollDelta(5); }
  1557.  
  1558.     {check for error}
  1559.     if VB.GetLastError <> 0 then
  1560.       Abort;
  1561.  
  1562.   {$IFDEF TestStream}
  1563.     {create stream file}
  1564.     S.Init('FBDEMO.STM', SCreate, 4096);
  1565.  
  1566.     {register types and store the entry screen}
  1567.     S.RegisterHier(VBrowserStream);                {! required !}
  1568.     S.RegisterPointer(1000, Pf);                   {! required !}
  1569.     S.RegisterPointer(1001, @Person);              {! required !}
  1570.     S.RegisterPointer(1002, @BuildRow);            {v optional v}
  1571.     S.RegisterPointer(1003, @UpdateScreen);
  1572.     S.RegisterPointer(1004, @ErrorHandler);
  1573.     S.RegisterPointer(1005, @RefreshPeriodically);
  1574.     S.Put(VB);
  1575.     if S.GetStatus <> 0 then begin
  1576.       WriteLn('Store error');
  1577.       Halt(2);
  1578.     end;
  1579.     S.Done;
  1580.     VB.Done;
  1581.  
  1582.     {reopen stream file}
  1583.     S.Init('FBDEMO.STM', SOpen, 4096);
  1584.  
  1585.     {register types and load the entry screen}
  1586.     S.RegisterHier(VBrowserStream);                {! required !}
  1587.     S.RegisterPointer(1000, Pf);                   {! required !}
  1588.     S.RegisterPointer(1001, @Person);              {! required !}
  1589.     S.RegisterPointer(1002, @BuildRow);            {v optional v}
  1590.     S.RegisterPointer(1003, @UpdateScreen);
  1591.     S.RegisterPointer(1004, @ErrorHandler);
  1592.     S.RegisterPointer(1005, @RefreshPeriodically);
  1593.     S.Get(VB);
  1594.     if S.GetStatus <> 0 then begin
  1595.       WriteLn('Load error');
  1596.       Halt(3);
  1597.     end;
  1598.     S.Done;
  1599.   {$ENDIF}
  1600.  
  1601.   end;
  1602.  
  1603.   procedure GetOptionsFromCommandLine;
  1604.     {-Get the network type (and station number if necessary) from Command line}
  1605.   type
  1606.     Str128 = String[128];
  1607.   var
  1608.     Opt : Str128;
  1609.   const
  1610.     {$IFDEF DynamicNet}
  1611.     ParamNum = 2;
  1612.     {$ELSE}
  1613.     ParamNum = 1;
  1614.     {$ENDIF}
  1615.  
  1616.     procedure ShowHelp;
  1617.       {-Display help message and halt}
  1618.     begin
  1619.       WriteLn('Usage: FBDEMO /opt [wn]');
  1620.       WriteLn;
  1621.       WriteLn('where opt is:');
  1622.       WriteLn('  /?   - Displays this help screen');
  1623.       WriteLn('  /D   - Single-user DOS, no network');
  1624.       WriteLn('  /N   - Novell''s Advanced NetWare');
  1625.       WriteLn('  /C   - CBIS'' Network-OS');
  1626.       WriteLn('  /M   - MS-Net or compatible');
  1627.       WriteLn('  /B   - MS-Net compatible with NetBIOS machine name support');
  1628.       WriteLn('  /P   - Software Link''s PC-MOS 386');
  1629.       WriteLn('  /V   - Banyan''s Vines');
  1630.       WriteLn('  /X   - Alloy''s NTNX');
  1631.       WriteLn;
  1632.       WriteLn('[wn] is the workstation number, used only with the /M option');
  1633.       Halt;
  1634.     end;
  1635.  
  1636.     procedure InvalidOption(Opt : Str128);
  1637.       {-Display invalid option message, show help, and halt}
  1638.     begin
  1639.       WriteLn('Invalid Option: ',Opt);
  1640.       WriteLn;
  1641.       ShowHelp;
  1642.     end;
  1643.  
  1644.   begin
  1645.     {$IFDEF DynamicNet}
  1646.     if ParamCount = 0 then
  1647.       ShowHelp
  1648.     else begin
  1649.       Opt := ParamStr(1);
  1650.       if Length(Opt) < 2 then
  1651.         InvalidOption(Opt);
  1652.     end;
  1653.     case UpCase(Opt[2]) of
  1654.       '?' : ShowHelp;
  1655.       'N' : DynamicNetType := Novell;
  1656.       'C' : DynamicNetType := CBISNet;
  1657.       'P' : DynamicNetType := PCMos386;
  1658.       'V' : DynamicNetType := VinesNet;
  1659.       'M' : DynamicNetType := MsNet;
  1660.       'B' : DynamicNetType := MsNetMachName;
  1661.       'X' : DynamicNetType := NTNXNet;
  1662.       'D' : DynamicNetType := NoNet;
  1663.       else InvalidOption(Opt);
  1664.     end; {case}
  1665.     {$ENDIF}
  1666.  
  1667.     {Get the workstation number}
  1668.     case NetSupported of
  1669.       NoNet :
  1670.         {do nothing} ;
  1671.       Novell, MsNetMachName, CBISNet
  1672.       {$IFNDEF UseFiler500}
  1673.       , NTNXNet, VinesNet
  1674.       {$ENDIF}
  1675.         :
  1676.         {These automatically determine the workstation number}
  1677.         ;
  1678.       {PCMOS386 also automatically determines the workstation number}
  1679.       PcMos386 :
  1680.         if not SetDosRetry(1, 1) then
  1681.           Halt;
  1682.       else
  1683.         begin
  1684.           if ParamCount <> 2 then begin
  1685.             Write('The /M option requires the workstation number as ');
  1686.             {$IFDEF DynamicNet}
  1687.             WriteLn('the second parameter, as in:');
  1688.             WriteLn('FBDEMO /M 2');
  1689.             {$ELSE}
  1690.             WriteLn('a parameter');
  1691.             {$ENDIF}
  1692.             Halt;
  1693.           end;
  1694.           if not Str2Int(ParamStr(ParamNum), IsamWSNr) then begin
  1695.             WriteLn('The workstation number must be an integer');
  1696.             Halt;
  1697.           end;
  1698.           if (IsamWSNr < 1) or (IsamWSNr > MaxNrOfWorkStations) then begin
  1699.             WriteLn('Invalid workstation number. Must be in range 1..',
  1700.                     MaxNrOfWorkStations);
  1701.             Halt;
  1702.           end;
  1703.         end;
  1704.     end;
  1705.   end;
  1706.  
  1707.   procedure FBDemoMain;
  1708.     {-Main body of FBDEMO}
  1709.   begin
  1710.     {parse the command line}
  1711.     GetOptionsFromCommandLine;
  1712.  
  1713.     {initialize screen}
  1714.     InitEntryScreen;
  1715.     InitMemoFields;
  1716.     SaveAttr := TextAttr;
  1717.  
  1718.     {clear the screen}
  1719.     TextChar := #178;
  1720.     TextAttr := $07;
  1721.     ClrScr;
  1722.  
  1723.     with FbColors do
  1724.       HeadFootAttr := ColorMono(FrameColor, FrameMono);
  1725.  
  1726.     CheckBreak := False;
  1727.  
  1728.     {other initialization}
  1729.     ActRec := 0;
  1730.     ActKeyNr := 1;
  1731.     ActKey := '';
  1732.  
  1733.     WriteHeader(' Initializing ', False);
  1734.  
  1735.     InitNetIsam(NetSupported <> NoNet);
  1736.     if not IsamOK then begin
  1737.       IsamErrorNum(IsamError);
  1738.       Halt;
  1739.     end;
  1740.  
  1741.     {allocate a buffer for variable length records}
  1742.     if not SetVariableRecBuffer(SectionLength) then begin
  1743.       DispMessageTemp('Insufficient memory. Program aborting.', 2000);
  1744.       Halt;
  1745.     end;
  1746.  
  1747.     PS := GetPageStack(25000+(400*ScreenHeight));
  1748.     if not IsamOK then begin
  1749.       DispMessageTemp('Insufficient memory. Program aborting.', 2000);
  1750.       Halt;
  1751.     end;
  1752.  
  1753.     if YesNo('Should the files be handled using Save mode?', 'N') then
  1754.       Mode := SaveMode
  1755.     else
  1756.       Mode := NormalMode;
  1757.  
  1758.     if not OpenedFiles then begin
  1759.       DispMessageTemp('Files could not be opened. Aborting.', 2000);
  1760.       Halt;
  1761.     end;
  1762.  
  1763.     {$IFDEF Novell}
  1764.     if NetSupported = Novell then
  1765.       if Sync.Init(FName, 2) then
  1766.         RefreshPeriod := 9            {check every half of a second}
  1767.       else begin
  1768.         DispMessageTemp('Error initializing semaphore object. Aborting.', 2000);
  1769.         Halt;
  1770.       end;
  1771.     {$ENDIF}
  1772.  
  1773.     EnableSearchForSequential(Pf, 1);
  1774.     EnableSearchForSequential(Pf, 2);
  1775.  
  1776.     {initialize file browser}
  1777.     InitBrowser;
  1778.  
  1779.     {$IFDEF UseMouse}
  1780.     if MouseInstalled then begin
  1781.       {use a red diamond for our mouse cursor}
  1782.       with fbColors do
  1783.         SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+$04);
  1784.       ShowMouse;
  1785.  
  1786.       {enable mouse support}
  1787.       EntryCommands.cpOptionsOn(cpEnableMouse);
  1788.       MemoCommands.cpOptionsOn(cpEnableMouse);
  1789.       FBrowserCommands.cpOptionsOn(cpEnableMouse);
  1790.     end;
  1791.     {$ENDIF}
  1792.  
  1793.     repeat
  1794.       {make sure there are records to display}
  1795.       if UsedRecs(Pf) = 0 then begin
  1796.         if YesNo('There are no records. Add one?', 'Y') then
  1797.           BrowExit := ccUser2
  1798.         else
  1799.           BrowExit := ccQuit;
  1800.       end
  1801.       else begin
  1802.         {Update the screen and browse around the records}
  1803.         WriteHeader(' Main Menu ', True);
  1804.         WriteFooter('F2-Add  F3-Del  F4-Find  F5-Key  F6-Filter  F8-Prn  F9-Info  F10-Purge  Esc-Quit');
  1805.  
  1806.         {process commands}
  1807.         VB.Process;
  1808.         BrowExit := VB.GetLastCommand;
  1809.         WriteFooter('');
  1810.  
  1811.         {Check for errors}
  1812.         case VB.GetLastError of
  1813.           0 :
  1814.             if (BrowExit <> ccQuit) and (BrowExit <> ccError) then begin
  1815.               {get current key and reference}
  1816.               VB.GetCurrentKeyAndRef(ActKey, ActRec);
  1817.  
  1818.               {Person already contains current record on ccSelect}
  1819.               if BrowExit <> ccSelect then
  1820.                 {get current record}
  1821.                 VB.GetCurrentRecord(Person, DatLen);
  1822.  
  1823.               {check for error}
  1824.               if not IsamOK then begin
  1825.                 IsamErrorNum(IsamError);
  1826.                 BrowExit := ccNone;
  1827.               end;
  1828.             end;
  1829.           epFatal+ecNoKeysFound :
  1830.             begin
  1831.               if VB.IsFilteringEnabled then begin
  1832.                 VB.SetFilterFunc(NullFilterFunc);
  1833.                 BrowExit := ccNone;
  1834.               end;
  1835.               VB.ClearErrors;
  1836.             end;
  1837.           else
  1838.             DispMessageTemp('Aborting.', 2000);
  1839.             BrowExit := ccError;
  1840.         end;
  1841.       end;
  1842.  
  1843.       {Handle requests for action}
  1844.       case BrowExit of
  1845.         ccSelect : Modify;
  1846.         ccUser2  : NewStructure;
  1847.         ccUser3  : Delete;
  1848.         ccUser4  : Search;
  1849.         ccUser5  : SwitchKeys;
  1850.         ccUser6  : Filter;
  1851.         ccUser8  : List;
  1852.         ccUser9  : Status;
  1853.         ccUser10 : RebuildData;
  1854.         {$IFDEF UseAdjustableWindows}
  1855.         ccUser11 : ResizeBrowseWindow;
  1856.         ccUser12 : MoveBrowseWindow;
  1857.         ccUser13 : ToggleZoom;
  1858.         {$ENDIF}
  1859.         ccQuit   : if not YesNo('Quit program?', 'N') then
  1860.                      BrowExit := ccNone;
  1861.       end;
  1862.     until (BrowExit = ccQuit) or (BrowExit = ccError);
  1863.  
  1864.     {Close up the database}
  1865.     CloseNetFileBlock(Pf);
  1866.     if not IsamOK then
  1867.       DispMessageTemp('Data may be corrupt.', 2000);
  1868.     ReleasePageStack;
  1869.     ExitNetIsam;
  1870.     ReleaseVariableRecBuffer;
  1871.  
  1872.     {$IFDEF UseMouse}
  1873.     HideMouse;
  1874.     {$ENDIF}
  1875.  
  1876.     {clear the screen}
  1877.     VB.Erase;
  1878.     TextAttr := SaveAttr;
  1879.     ClrScr;
  1880.     {$IFDEF Novell}
  1881.     if NetSupported = Novell then
  1882.       Sync.Done;
  1883.     {$ENDIF}
  1884.   end;
  1885.  
  1886. end.
  1887.  
  1888.